!############################# Change Log ##################################
! 5.0.0
!
!###########################################################################
!  Copyright (C)  1990, 1995, 1999, 2000, 2003 - All Rights Reserved
!  Regional Atmospheric Modeling System - RAMS
!###########################################################################

subroutine master_sendinit()

  use var_tables, only: &
       num_var,         & !INTENT(IN)
       vtab_r             !INTENT(IN)

  use mem_scratch, only: &
       maxgrds,          & !INTENT(IN)
       scratch             !INTENT(INOUT)

  use mem_cuparm, only: &
       cutime1,         & !INTENT(IN)
       cutime2            !INTENT(IN)

  use mem_varinit, only: &
       vtime1,           & !INTENT(IN)
       vtime2,           & !INTENT(IN)
       htime1,           & !INTENT(IN)
       htime2,           & !INTENT(IN)
       condtime1,        & !INTENT(IN)
       condtime2           !INTENT(IN)

  use mem_grid, only: &
       ngrids,        & !INTENT(IN)
       nnxp,          & !INTENT(IN)
       nnyp,          & !INTENT(IN)
       nnzp,          & !INTENT(IN)
       nzg,           & !INTENT(IN)
       npatch,        & !INTENT(IN)
       nzs              !INTENT(IN)

  use io_params, only: &
       ssttime1,       & !INTENT(IN)
       ssttime2,       & !INTENT(IN)
       ndvitime1,      & !INTENT(IN)
       ndvitime2         !INTENT(IN)
  
  use rpara, only:   &
       nmachs,       & !INTENT(IN)
       machnum,      & !INTENT(IN)
       nxend, nxbeg, & !INTENT(IN)
       nyend, nybeg    !INTENT(IN)

  use mem_aerad, only: nwave !INTENT(IN) ! For CATT
 !srf - chem
  use chem_sources, only: srctime1,srctime2 !intent(in)
 !srf - chem - end

  implicit none
  ! Local Variables:
  integer           :: nm, nwords, mxp, myp, mxyp, mxyzp, nv, npts, ng
  integer           :: ipos, scr_buf_len
  real, allocatable :: scr_buf(:)

!srf- for chem
  !nwords = 4*maxgrds + 8
  nwords = 4*maxgrds + 10 !srf: plus 2 real numbers

  call parf_pack_max_size(nwords, scr_buf_len)
  allocate(scr_buf(scr_buf_len))

  do nm = 1,nmachs

     ipos = 1
     call parf_pack_real(vtime1,    1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(vtime2,       1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(htime1,       1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(htime2,       1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(condtime1,    1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(condtime2,    1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(cutime1,      1,       scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(cutime2,      1,       scr_buf(1), scr_buf_len, ipos)
!srf
     call parf_pack_real(srctime1,     1,	scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(srctime2,     1,	scr_buf(1), scr_buf_len, ipos)
!srf
     call parf_pack_real(ssttime1(1),  maxgrds, scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(ssttime2(1),  maxgrds, scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(ndvitime1(1), maxgrds, scr_buf(1), scr_buf_len, ipos)
     call parf_pack_real(ndvitime2(1), maxgrds, scr_buf(1), scr_buf_len, ipos)
     call parf_send_block(scr_buf(1), scr_buf_len, machnum(nm), 110)

     do ng = 1,ngrids

        mxp = nxend(nm,ng) - nxbeg(nm,ng) + 1
        myp = nyend(nm,ng) - nybeg(nm,ng) + 1
        mxyp = mxp * myp
        mxyzp = mxyp * nnzp(ng)

        !  Send variables that the nodes will only have the subdomain portion of

        do nv = 1,num_var(ng)

           if ( vtab_r(nv,ng)%impti == 1) then

              if ( vtab_r(nv,ng)%idim_type == 2) then

                 call mk_2_buff(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1),nnxp(ng),nnyp(ng),mxp,myp  &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyp

              elseif ( vtab_r(nv,ng)%idim_type == 3) then

                 call mk_3_buff(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1),nnzp(ng),nnxp(ng),nnyp(ng)  &
                      ,nnzp(ng),mxp,myp  &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyzp

              elseif ( vtab_r(nv,ng)%idim_type == 4) then

                 call mk_4_buff(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1),nzg,nnxp(ng),nnyp(ng)  &
                      ,npatch,nzg,mxp,myp,npatch &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyp*nzg*npatch

              elseif ( vtab_r(nv,ng)%idim_type == 5) then

                 call mk_4_buff(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1),nzs,nnxp(ng),nnyp(ng)  &
                      ,npatch,nzs,mxp,myp,npatch &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyp*nzs*npatch

              elseif ( vtab_r(nv,ng)%idim_type == 6) then

                 call mk_2p_buff(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1),nnxp(ng),nnyp(ng)  &
                      ,npatch,mxp,myp,npatch &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyp*npatch

              elseif ( vtab_r(nv,ng)%idim_type == 7) then

                 call mk_buff_carma(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1) &
                      ,nnxp(ng),nnyp(ng),nwave &
                      ,mxp,myp,nwave &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyp*nwave

              elseif ( vtab_r(nv,ng)%idim_type == 8) then

                 ! 3D Soil Layers with no patch dimension
                 call mk_2p_buff(vtab_r(nv,ng)%var_p  &
                      ,scratch%scr2(1),nnxp(ng),nnyp(ng)  &
                      ,nzg,mxp,myp,nzg &
                      ,nxbeg(nm,ng),nxend(nm,ng)  &
                      ,nybeg(nm,ng),nyend(nm,ng))
                 npts=mxyp*nzg

              endif

              call parf_send_real(scratch%scr2(1), npts, machnum(nm), 110+ng)

           endif

        enddo

     enddo
  enddo

  deallocate(scr_buf)

end subroutine master_sendinit

!---------------------------------------------------------------------------

!For Carma - CATT
subroutine mk_buff_carma(a,b,n1,n2,n3,m1,m2,m3,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,m1,m2,m3,i1,i2,j1,j2
  real :: a(n1,n2,n3),b(m1,m2,m3)

  b(1:m1,1:m2,1:m3)=a(i1:i2,j1:j2,1:n3)

  return
end subroutine mk_buff_carma

!---------------------------------------------------------------------------

subroutine mk_2_buff(a,b,n1,n2,m1,m2,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,m1,m2,i1,i2,j1,j2
  real :: a(n1,n2),b(m1,m2)

  b(1:m1,1:m2)=a(i1:i2,j1:j2)

  return
end subroutine mk_2_buff

!---------------------------------------------------------------------------

subroutine mk_2p_buff(a,b,n1,n2,n3,m1,m2,m3,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,m1,m2,m3,i1,i2,j1,j2
  real :: a(n1,n2,n3),b(m1,m2,m3)

  b(1:m1,1:m2,1:m3)=a(i1:i2,j1:j2,1:n3)

  return
end subroutine mk_2p_buff

!---------------------------------------------------------------------------

subroutine mk_3_buff(a,b,n1,n2,n3,m1,m2,m3,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,m1,m2,m3,i1,i2,j1,j2
  real :: a(n1,n2,n3),b(m1,m2,m3)

  b(1:m1,1:m2,1:m3)=a(1:n1,i1:i2,j1:j2)

  return
end subroutine mk_3_buff

!---------------------------------------------------------------------------

subroutine mk_4_buff(a,b,n1,n2,n3,n4,m1,m2,m3,m4,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,n4,m1,m2,m3,m4,i1,i2,j1,j2
  real :: a(n1,n2,n3,m4),b(m1,m2,m3,m4)

  b(1:m1,1:m2,1:m3,1:m4)=a(1:n1,i1:i2,j1:j2,1:n4)

  return
end subroutine mk_4_buff

!     ****************************************************************

subroutine node_getinit()

  use var_tables, only: &
       num_var,         & !INTENT(IN)
       vtab_r             !INTENT(IN)

  use mem_scratch, only: &
       maxgrds             !INTENT(IN)

  use mem_cuparm, only: &
       cutime1,         & !INTENT(IN)
       cutime2            !INTENT(IN)

  use mem_varinit, only: &
       vtime1,           & !INTENT(IN)
       vtime2,           & !INTENT(IN)
       htime1,           & !INTENT(IN)
       htime2,           & !INTENT(IN)
       condtime1,        & !INTENT(IN)
       condtime2           !INTENT(IN)

  use mem_grid, only: &
       ngrids            !INTENT(IN)

  use io_params, only: &
       ssttime1,       & !INTENT(IN)
       ssttime2,       & !INTENT(IN)
       ndvitime1,      & !INTENT(IN)
       ndvitime2         !INTENT(IN)

  use node_mod, only: &
       master_num       !INTENT(IN)

  !srf - chem
  use chem_sources, only: srctime1,srctime2 !intent(in)
  !srf - chem - end

 implicit none

  ! Local Variables:
  integer           :: nwords, nv
  integer           :: ng
  integer           :: ipos, scr_buf_len
  real, allocatable :: scr_buf(:)

!srf- for chem
  !nwords = 4*maxgrds + 8
   nwords = 4*maxgrds + 10 !srf: plus 2 real numbers

  call parf_pack_max_size(nwords, scr_buf_len)
  allocate(scr_buf(scr_buf_len))
  ipos = 1

  call parf_get_block(scr_buf(1), scr_buf_len, master_num, 110)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, vtime1,       1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, vtime2,       1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, htime1,       1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, htime2,       1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, condtime1,    1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, condtime2,    1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, cutime1,      1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, cutime2,      1)

!srf
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, srctime1,       1)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, srctime2,       1)
!srf
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, ssttime1(1),  maxgrds)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, ssttime2(1),  maxgrds)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, ndvitime1(1), maxgrds)
  call parf_unpack_real(scr_buf(1), scr_buf_len, ipos, ndvitime2(1), maxgrds)

  do ng = 1,ngrids

     do nv=1,num_var(ng)

        if (vtab_r(nv,ng)%impti == 1) then
           call parf_get_real(vtab_r(nv,ng)%var_p, vtab_r(nv,ng)%npts, &
                master_num, 110+ng)
        endif

     enddo

  enddo

  deallocate(scr_buf)

end subroutine node_getinit

!     *****************************************************************

subroutine node_sendall()

  use node_mod, only: &
       mynum, master_num ! INTENT(IN)

  use mem_grid, only: &
       ngrids            ! INTENT(IN)

  use var_tables, only: &
       num_var, &        ! INTENT(IN)
       vtab_r            ! INTENT(IN)

  implicit none

  integer, parameter :: ntags=5
  integer :: msgtags(ntags), nv, ng
  real, allocatable :: buf_send(:)
  integer :: max_len, max_size, ipos
  integer, parameter :: msgnum=1001

  ! Calculating the lenght of output buffer
  max_len = 0
  do ng=1, ngrids
     do nv=1, num_var(ng)
        if (vtab_r(nv,ng)%impt3 == 1) then
           if (vtab_r(nv,ng)%npts > max_len) max_len = vtab_r(nv,ng)%npts
        endif
     enddo
  enddo
  max_len = max_len + 5
  call parf_pack_max_size(max_len, max_size)
  allocate(buf_send(max_size))

  do ng=1,ngrids

     msgtags(1)=mynum
     msgtags(2)=ng

     do nv=1,num_var(ng)

        if (vtab_r(nv,ng)%impt3 == 1) then

           msgtags(3)= int(vtab_r(nv,ng)%npts)
           msgtags(5)= nv
           msgtags(4)= vtab_r(nv,ng)%idim_type
           
           ipos = 1
           call parf_pack_int (msgtags, ntags, buf_send, max_size, ipos)
           call parf_pack_real(vtab_r(nv,ng)%var_p, vtab_r(nv,ng)%npts, &
                buf_send, max_size, ipos)
           call parf_send_block(buf_send, max_size, master_num, msgnum)

        endif

     enddo

  enddo

  deallocate(buf_send)

end subroutine node_sendall

!     ****************************************************************

subroutine master_getall()

  use mem_grid, only:    &
       ngrids,           & ! INTENT(IN)
       nnzp, nnxp, nnyp, & ! INTENT(IN)
       nzg, npatch, nzs    ! INTENT(IN)

  use rpara, only: &
       nmachs,     & ! INTENT(IN)
       nxbegc,     & ! INTENT(IN)
       nxendc,     & ! INTENT(IN)
       nybegc,     & ! INTENT(IN)
       nyendc,     & ! INTENT(IN)
       ibcflg,     & ! INTENT(IN)
       nxbeg,      & ! INTENT(IN)
       nxend,      & ! INTENT(IN)
       nybeg,      & ! INTENT(IN)
       nyend,      & ! INTENT(IN)
       ixoff,      & ! INTENT(IN)
       iyoff         ! INTENT(IN)

  use var_tables, only: &
       num_var, &        ! INTENT(IN)
       vtab_r            ! INTENT(IN)

  ! For CATT
  use mem_aerad, only: nwave

  implicit none
  integer, parameter :: ntags=5
  integer :: msgtags(ntags), numvars, nummess, nvvv, mxp, myp, mxyp
  integer :: ibytes, msgtyp, ihostnum
  integer :: nm, il1, ir2, jb1, jt2, nv, idim_type, npts, ng
  integer :: nmi, nvi, ngi
  real, allocatable :: buf_get(:), buf_scr(:)
  integer :: max_len, max_size, ipos, host_msg
  integer, parameter :: msgtag=1001

  ! DEBUG-ALF - versao antiga
  ! Calculating the lenght of input buffer and max number of messages
  numvars = 0
  max_len = 0
  do ng=1,ngrids
     do nv=1,num_var(ng)
        if (vtab_r(nv,ng)%impt3 == 1) then
           numvars=numvars+1
           if (vtab_r(nv,ng)%npts > max_len) max_len = vtab_r(nv,ng)%npts
        endif
     enddo
  enddo
  nummess=numvars*nmachs
  allocate(buf_scr(max_len))
  max_len = max_len + 5
  call parf_pack_max_size(max_len, max_size)
  allocate(buf_get(max_size))

  do nvvv=1,nummess

     call parf_get_block_any(buf_get, max_size, msgtag, host_msg)
     ipos = 1
     call parf_unpack_int(buf_get, max_size, ipos, msgtags, ntags)

     nm=msgtags(1)
     ng=msgtags(2)
     npts=msgtags(3)
     idim_type=msgtags(4)
     nv=msgtags(5)

     il1=nxbegc(nm,ng)
     ir2=nxendc(nm,ng)
     jb1=nybegc(nm,ng)
     jt2=nyendc(nm,ng)

     if(iand(ibcflg(nm,ng),1).ne.0) il1=il1-1
     if(iand(ibcflg(nm,ng),2).ne.0) ir2=ir2+1
     if(iand(ibcflg(nm,ng),4).ne.0) jb1=jb1-1
     if(iand(ibcflg(nm,ng),8).ne.0) jt2=jt2+1

     mxp = nxend(nm,ng) - nxbeg(nm,ng) + 1
     myp = nyend(nm,ng) - nybeg(nm,ng) + 1
     mxyp = mxp * myp

     call parf_unpack_real(buf_get, max_size, ipos, buf_scr, npts)

     if (idim_type == 2) then
        call ex_2_buff(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nnxp(ng), nnyp(ng), mxp, myp,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     elseif (idim_type == 3) then
        call ex_3_buff(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nnzp(ng), nnxp(ng), nnyp(ng), nnzp(ng), mxp, myp,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     elseif (idim_type == 4) then
        call ex_4_buff(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nzg, nnxp(ng), nnyp(ng), npatch, nzg, mxp, myp, npatch,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     elseif (idim_type == 5) then
        call ex_4_buff(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nzs, nnxp(ng), nnyp(ng), npatch, nzs, mxp, myp, npatch,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     elseif (idim_type == 6) then
        call ex_2p_buff(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nnxp(ng), nnyp(ng), npatch, mxp, myp, npatch,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     elseif (idim_type == 7) then
        call ex_buff_carma(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nnxp(ng), nnyp(ng), nwave, mxp, myp, nwave,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     elseif (idim_type == 8) then
        ![ED2-MLO: tridimensional variables, with vertical dimension 
        !being the number soil levels
        call ex_2p_buff(vtab_r(nv,ng)%var_p, buf_scr(1),  &
             nnxp(ng), nnyp(ng), nzg, mxp, myp, nzg,  &
             ixoff(nm,ng), iyoff(nm,ng), il1, ir2, jb1, jt2)
     endif

  enddo

  deallocate(buf_get)
  deallocate(buf_scr)

end subroutine master_getall

!---------------------------------------------------------------------------

subroutine ex_buff_carma(a,b,n1,n2,n3,m1,m2,m3,i0,j0,i1,i2,j1,j2)
  !i0 = ixoff(nm,ng)
  !j0 = iyoff(nm,ng)
  !i1 = il1
  !i2 = ir2
  !j1 = jb1
  !j2 = jt2
  implicit none
  integer :: n1,n2,n3,m1,m2,m3,i0,j0,i1,i2,j1,j2
  real :: a(n1,n2,n3),b(m1,m2,m3)

  a(i1+i0:i2+i0,j1+j0:j2+j0,1:n3) = b(i1:i2,j1:j2,1:m3)

  return
end subroutine ex_buff_carma

!---------------------------------------------------------------------------

subroutine ex_2_buff(a,b,n1,n2,m1,m2,i0,j0,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,m1,m2,i0,j0,i1,i2,j1,j2
  real :: a(n1,n2),b(m1,m2)

  a(i1+i0:i2+i0,j1+j0:j2+j0) = b(i1:i2,j1:j2)

  return
end subroutine ex_2_buff

!---------------------------------------------------------------------------

subroutine ex_3_buff(a,b,n1,n2,n3,m1,m2,m3,i0,j0,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,m1,m2,m3,i0,j0,i1,i2,j1,j2
  real :: a(n1,n2,n3),b(m1,m2,m3)

  a(1:n1,i1+i0:i2+i0,j1+j0:j2+j0) = b(1:m1,i1:i2,j1:j2)

  return
end subroutine ex_3_buff

!---------------------------------------------------------------------------

subroutine ex_4_buff(a,b,n1,n2,n3,n4,m1,m2,m3,m4,i0,j0,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,n4,m1,m2,m3,m4,i0,j0,i1,i2,j1,j2
  real :: a(n1,n2,n3,n4),b(m1,m2,m3,m4)

  a(1:n1,i1+i0:i2+i0,j1+j0:j2+j0,1:n4) = b(1:m1,i1:i2,j1:j2,1:m4)

  return
end subroutine ex_4_buff

!---------------------------------------------------------------------------

subroutine ex_2p_buff(a,b,n1,n2,n3,m1,m2,m3,i0,j0,i1,i2,j1,j2)
  implicit none
  integer :: n1,n2,n3,m1,m2,m3,i0,j0,i1,i2,j1,j2
  real :: a(n1,n2,n3),b(m1,m2,m3)

  a(i1+i0:i2+i0,j1+j0:j2+j0,1:n3) = b(i1:i2,j1:j2,1:m3)

  return
end subroutine ex_2p_buff
